000100*AAAABBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBCCCCCCCC
000200*                      
000300*                    (SEQ)                        (SEQ)                  
000400 IDENTIFICATION DIVISION.
000500 PROGRAM-ID.                 DYNTEST.
000600*AUTHOR.                     KENJI KIMURA.
000700 ENVIRONMENT DIVISION.
000800 INPUT-OUTPUT SECTION.
000900 FILE-CONTROL.
001000*                        
001100*ACMFILE
001200*ACMRECNAME=I-RECORD
001300 SELECT INP-FILE ASSIGN TO "dbtests2"
001400        ORGANIZATION IS INDEXED
001500        ACCESS MODE  IS DYNAMIC
001600        RECORD KEY   IS I-ID.
001700 DATA DIVISION.
001800 FILE SECTION.
001900*                    
002000 FD  INP-FILE.
002100 COPY "I_RECORD2.cbl".
002200 WORKING-STORAGE SECTION.
002300 01  SOME-AREA.
002400     05  I-COUNTER           PIC 9(05).
002500     05  O-COUNTER           PIC 9(05).
002600     05  END-FLG             PIC 9(01)  VALUE  ZERO.
002700 01  FUDOU-AREA.
002800     05  W-FUDOU             PIC S9(4)V9(3).
002900     05  INTDATA             PIC 9(07).
003000     05  INTWORK             PIC 9(07).
003100     05  INT1000             PIC 9(07).
003200     05  INTDEC              PIC 9(07).
003300*
003400 COPY "SCR_RECORD.cbl".
003500*ACMCOMMENTSTART
003600 SCREEN SECTION.
003700*
003800 COPY "DSP_RECORD.cbl".
003900*ACMCOMMENTEND
004000 PROCEDURE DIVISION.
004100*              
004200 MAIN SECTION.
004300     PERFORM   INIT.
004400     PERFORM   FL-OPEN.
004500*                                                      
004600     PERFORM   UNTIL  END-FLG  NOT  =  ZERO
004700*ACMCOMMENTSTART
004800        DISPLAY   DSP-RECORD2
004900        ACCEPT    DSP-RECORD1
005000*ACMCOMMENTEND
005100*ACMINSERTSTART
005200*       ACCEPT    SCR-RECORD
005300*ACMINSERTEND
005400        EVALUATE  SCR-PROC
005500        WHEN  0
005600*                 
005700            MOVE  1  TO  END-FLG
005800        WHEN  1
005900*                 
006000            PERFORM  OUT-WRITE
006100        WHEN  2
006200*                       
006300            PERFORM  INP-READ
006400        WHEN  3
006500*                   
006600            PERFORM  OUT-REWRITE
006700        WHEN  9
006800*                 
006900            PERFORM  OUT-DELETE
007000        END-EVALUATE
007100*ACMINSERTSTART
007200*       DISPLAY   SCR-RECORD
007300*ACMINSERTEND
007400     END-PERFORM.
007500     PERFORM   FL-CLOSE.
007600     PERFORM   TERM.
007700     STOP RUN.
007800*              
007900 INIT SECTION.
008000*ACMCOMMENTSTART
008100     DISPLAY   "PROGRAM STARTING.".
008200*ACMCOMMENTEND
008300     EXIT.
008400*                      
008500 FL-OPEN SECTION.
008600     OPEN   I-O  INP-FILE.
008700     EXIT.
008800*                  
008900 INP-READ SECTION.
009000     MOVE SCR-ID  TO  I-ID.
009100     READ INP-FILE 
009200     INVALID KEY
009300*ACMCOMMENTSTART
009400         DISPLAY  "CANT FIND"
009500         MOVE  1  TO  END-FLG
009600*ACMCOMMENTEND
009700*ACMINSERTSTART
009800*        MOVE ALL "0" TO I-RECORD
009900*ACMINSERTEND
010000     END-READ.
010100     IF  END-FLG  =  ZERO
010200*                                                                
010300         ADD  1              TO  I-COUNTER
010400         PERFORM REC2SCR
010500     END-IF.
010600     EXIT.
010700*                  
010800 OUT-WRITE SECTION.
010900     PERFORM SCR2REC.
011000     WRITE I-RECORD
011100     INVALID KEY
011200         MOVE  1  TO  END-FLG
011300     NOT INVALID KEY
011400         INITIALIZE   SCR-RECORD
011500     END-WRITE.
011600     ADD  1                  TO  O-COUNTER.
011700     EXIT.
011800*                  
011900 OUT-REWRITE SECTION.
012000     PERFORM SCR2REC.
012100     REWRITE I-RECORD
012200     INVALID  KEY
012300         MOVE  1  TO  END-FLG
012400     NOT INVALID KEY
012500         INITIALIZE   SCR-RECORD
012600     END-REWRITE.
012700     ADD  1                  TO  O-COUNTER.
012800     EXIT.
012900*                  
013000 OUT-DELETE SECTION.
013100     PERFORM SCR2REC.
013200     DELETE INP-FILE
013300     INVALID  KEY
013400         MOVE  1  TO  END-FLG
013500     NOT INVALID KEY
013600         INITIALIZE   SCR-RECORD
013700     END-DELETE.
013800     ADD  1                  TO  O-COUNTER.
013900     EXIT.
014000*                      
014100 REC2SCR SECTION.
014200     MOVE I-ID            TO SCR-ID.
014300     MOVE I-CD            TO SCR-CD.
014400     MOVE I-NIHONGO       TO SCR-NIHONGO.
014500*    MOVE I-SEISU         TO SCR-SEISU.
014600     IF  I-SEISU  >  ZERO
014700         MOVE I-SEISU     TO SCR-SEISU
014800         MOVE ZERO        TO SCR-SEISU-FLG
014900     ELSE
015000         COMPUTE SCR-SEISU = I-SEISU * (-1)
015100         MOVE    1        TO SCR-SEISU-FLG
015200     END-IF
015300     MOVE I-HIZUKE-YYYY   TO SCR-HIZUKE-YYYY.
015400     MOVE I-HIZUKE-MM     TO SCR-HIZUKE-MM.
015500     MOVE I-HIZUKE-DD     TO SCR-HIZUKE-DD.
015600     MOVE I-JIKOKU-HH     TO SCR-JIKOKU-HH.
015700     MOVE I-JIKOKU-MM     TO SCR-JIKOKU-MM.
015800     MOVE I-JIKOKU-SS     TO SCR-JIKOKU-SS.
015900*    MOVE I-FUDOU         TO SCR-FUDOU.
016000     IF  I-FUDOU  >  ZERO
016100         MOVE  I-FUDOU    TO W-FUDOU
016200         MOVE  ZERO       TO  SCR-FUDOU-FLG
016300     ELSE
016400         COMPUTE  W-FUDOU  =  I-FUDOU * (-1)
016500         MOVE  1          TO  SCR-FUDOU-FLG
016600     END-IF.
016700     COMPUTE  INT1000      =  W-FUDOU  *  1000.
016800     MOVE     W-FUDOU     TO  INTWORK.
016900     COMPUTE  INTDATA      =  INTWORK  *  1000.
017000     COMPUTE  INTDEC       =  INT1000  -  INTDATA.
017100     COMPUTE  SCR-FUDOU1   =  INT1000  /  1000.
017200     COMPUTE  SCR-FUDOU2   =  INTDEC.
017300     EXIT.
017400*                      
017500 SCR2REC SECTION.
017600     MOVE SCR-ID          TO I-ID.
017700     MOVE SCR-CD          TO I-CD.
017800     MOVE SCR-NIHONGO     TO I-NIHONGO.
017900*    MOVE SCR-SEISU       TO I-SEISU.
018000     IF  SCR-SEISU-FLG  = ZERO
018100         MOVE SCR-SEISU       TO I-SEISU
018200     ELSE
018300         COMPUTE  I-SEISU  = SCR-SEISU * (-1)
018400     END-IF
018500     MOVE SCR-HIZUKE-YYYY TO I-HIZUKE-YYYY.
018600     MOVE SCR-HIZUKE-MM   TO I-HIZUKE-MM.
018700     MOVE SCR-HIZUKE-DD   TO I-HIZUKE-DD.
018800     MOVE SCR-JIKOKU-HH   TO I-JIKOKU-HH.
018900     MOVE SCR-JIKOKU-MM   TO I-JIKOKU-MM.
019000     MOVE SCR-JIKOKU-SS   TO I-JIKOKU-SS.
019100*    MOVE SCR-FUDOU       TO I-FUDOU.
019200     COMPUTE  W-FUDOU     =  (SCR-FUDOU1  * 1000
019300                          +   SCR-FUDOU2) / 1000.
019400     IF  SCR-FUDOU-FLG  = ZERO
019500         MOVE  W-FUDOU    TO  I-FUDOU
019600     ELSE
019700         COMPUTE  I-FUDOU  =  W-FUDOU * (-1)
019800     END-IF.
019900     EXIT.
020000*                              
020100 FL-CLOSE SECTION.
020200     CLOSE  INP-FILE.
020300     EXIT.
020400*              
020500 TERM SECTION.
020600*ACMCOMMENTSTART
020700     DISPLAY   "PROGRAM NORMALLY TERMINATED.".
020800     DISPLAY   "INPUT-COUNT:" I-COUNTER.
020900     DISPLAY   "OUTPUT-COUNT:" O-COUNTER.
021000*ACMCOMMENTEND
021100     EXIT.
021200
